home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 3: The Continuation / 17-Bit_The_Continuation_Disc.iso / amigan / amigan 9 / automata / source / amcalc.mod < prev    next >
Encoding:
Modula Implementation  |  1994-01-27  |  1.9 KB  |  91 lines
  1. IMPLEMENTATION MODULE AMCalc;
  2.  
  3. (*  AMCalc presents the procedures and data types for the calculation of
  4.     one-dimensional cellular automata.
  5.  
  6.     Version 1.2d  by Mike Dryja   March 1, 1987  *)
  7.  
  8. FROM Storage IMPORT ALLOCATE, CreateHeap, DestroyHeap;
  9.  
  10. TYPE
  11.   Automata = POINTER TO RECORD
  12.              Cell : ARRAY[1..MaxAutomata] OF CellType;
  13.              END;
  14.          
  15. VAR
  16.   Rule : ARRAY[0..9] OF CellType;
  17.   Length : Range;
  18.  
  19. PROCEDURE EstablishRule (VAR String : RuleString);
  20.   VAR
  21.     i : CARDINAL;
  22.   BEGIN
  23.     FOR i := 0 TO 9 DO
  24.       Rule[i] := ORD (String[i])-48;
  25.       IF Rule[i] > 3 THEN
  26.         Rule[i] := 3;
  27.     String[i] := CHR (51);
  28.       END;
  29.     END;
  30.   END EstablishRule;
  31.  
  32. PROCEDURE Equate (VAR String : ARRAY OF CHAR; VAR InTo : Automata);
  33.   VAR
  34.     i : CARDINAL;
  35.   BEGIN
  36.     FOR i := 0 TO Length-1 DO
  37.       InTo^.Cell[i+1] := ORD (String[i])-48;
  38.     END;
  39.   END Equate;
  40.  
  41. PROCEDURE NextGeneration (VAR Parent, Daughter : Automata);
  42.   VAR
  43.     i : CARDINAL;
  44.   BEGIN
  45.     WITH Parent^ DO
  46.       FOR i := 1 TO Length DO
  47.         IF (i > 1) AND (i < Length) THEN
  48.           Daughter^.Cell[i] := Rule[Cell[i-1] + Cell[i] + Cell[i+1]];
  49.         ELSIF i = 1 THEN
  50.           Daughter^.Cell[i] := Rule[Cell[i] + Cell[i+1]];
  51.         ELSIF i = Length THEN
  52.           Daughter^.Cell[i] := Rule[Cell[i-1] + Cell[i]];
  53.         END;
  54.       END;
  55.     END;
  56.   END NextGeneration;
  57.  
  58. PROCEDURE SeeCell (State : Automata; X : Range) : CellType;
  59.   BEGIN
  60.     RETURN State^.Cell[X];
  61.   END SeeCell;
  62.  
  63. PROCEDURE Same (From, To : Automata);
  64.   BEGIN
  65.     To^ := From^;
  66.   END Same;
  67.  
  68. PROCEDURE Initialize (VAR State : Automata);
  69.   BEGIN
  70.     NEW (State);
  71.   END Initialize;
  72.  
  73. PROCEDURE SetLength (Value : Range);
  74.   BEGIN
  75.     Length := Value;
  76.   END SetLength;
  77.  
  78. PROCEDURE GetLength () : Range;
  79.   BEGIN
  80.     RETURN Length;
  81.   END GetLength;
  82.  
  83. PROCEDURE CloseCalc ();
  84.   BEGIN
  85.     DestroyHeap;
  86.   END CloseCalc;
  87.   
  88. BEGIN
  89.   IF CreateHeap (25000) = TRUE THEN END;
  90. END AMCalc.
  91.